home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Jörg's Folder / Compatibility.4th.inc < prev    next >
Encoding:
Text File  |  1992-06-10  |  11.2 KB  |  631 lines  |  [TEXT/QED1]
  1. ( === Compiler support words. === )
  2.  
  3. #ifndef _COMPATIBILITY_
  4.     #define _COMPATIBILITY_
  5.  
  6.     #ifndef _RECORDS_
  7.         INCLUDE" :Includes:Record_Defs.4th"
  8.     #endif
  9.  
  10.     #ifndef _MacTypes_
  11.         INCLUDE" :Includes:MacTypes.4th.inc"
  12.     #endif
  13.  
  14.     #ifndef _APPLETALK_
  15.         INCLUDE" :Includes:AppleTalk.4th.inc"
  16.     #endif
  17.  
  18.     #ifndef _TEMPMEM_
  19.         INCLUDE" :Includes:TempMem.4th"
  20.     #endif
  21.  
  22.     #ifndef _SYSEQU_
  23.         INCLUDE" :Includes:SysEqu.Txt"
  24.     #endif
  25.  
  26.     save.VOCAB.state
  27.     ONLY FORTH
  28.     ALSO ASSEMBLER
  29.     ALSO MAC DEFINITIONS
  30.  
  31. #ifdef _EMBEDDED_
  32.     .( Mac Compatibility testing words compiled for embedded code applications.)
  33.     CR
  34. #endif
  35.  
  36. DECIMAL
  37.  
  38. : ,NEWOS    ( set bit 9, clear bit 10 - for OS GetTrapAddress calls )
  39.     HERE 2- DUP
  40.     W@ $0200 OR $FBFF AND
  41.     SWAP W!
  42.     ;
  43.     IMMEDIATE
  44.  
  45.  
  46. : ,NEWTOOL    ( set bit 9 and 10 - for ToolBox GetTrapAddress calls )
  47.     HERE 2- DUP
  48.     W@ $0600 OR
  49.     SWAP W!
  50.     ;
  51.     IMMEDIATE
  52.  
  53. .TRAP    _UnknownTrap    $A89F
  54. .TRAP    _Unimplemented    $A89F
  55. .TRAP    _SysEnvirons    $A090
  56. .TRAP    _Gestalt        $A1AD
  57.  
  58. $9F        CONSTANT UnknownTrap.#
  59. $9F        CONSTANT Unimplemented.#
  60. $90        CONSTANT SysEnvirons.#
  61. $1AD    CONSTANT Gestalt.#
  62.  
  63. $A89F    CONSTANT UnknownTrap
  64. $A89F    CONSTANT Unimplemented
  65. $A090    CONSTANT SysEnvirons
  66. $A1AD    CONSTANT Gestalt
  67.  
  68. ( ===== System Globals ===== )
  69.  
  70. $12F    CONSTANT CPUFlag ( byte )
  71. $21E    CONSTANT KbdType ( byte )
  72. $291    CONSTANT PortBUse
  73. $A58    CONSTANT SysMap        ( global that contains System Map reference # )
  74. $B22    CONSTANT HWCfgFlags
  75. $B22    CONSTANT SCSIFlags
  76.  
  77. ( ===== System Global Constants ===== )
  78.  
  79. 15        CONSTANT SCSI.port.present.bit
  80. $8000    CONSTANT SCSI.port.present.mask
  81. 14        CONSTANT New.Clock.Chip.Present.bit
  82. $4000    CONSTANT New.Clock.Chip.Present.mask
  83. 13        CONSTANT Extra.PRAM.Valid.bit
  84. $2000    CONSTANT Extra.PRAM.Valid.mask ( at boottime )
  85. 4        CONSTANT has.FPU.bit ( in HwCfgFlags )
  86. $0010    CONSTANT has.FPU.mask
  87.  
  88. 0    CONSTANT OSTrap
  89. 1    CONSTANT ToolTrap
  90.  
  91. ( ===== SysEnviron record constants ===== )
  92.  
  93. :RECORD SysEnvRec
  94.     environsVersion    short
  95.     machineType        short
  96.     systemVersion    short
  97.     processor        short
  98.     hasFPU            char
  99.     hasColorQD        char
  100.     keyBoardType    short
  101.     atDrvrVersNum    short
  102.     sysVRefNum        short
  103. ;RECORD
  104.  
  105. CODE NGetTrapAddress.Tool
  106.     ( trap# -- addr )
  107.     MOVE.W    2(A6),D0
  108.             _GetTrapAddress ,NEWTOOL
  109.     MOVE.L    A0,(A6)
  110.     RTS
  111. END-CODE MACH
  112.  
  113. CODE NGetTrapAddress.OS
  114.     ( trap# -- addr )
  115.     MOVE.W    2(A6),D0
  116.             _GetTrapAddress ,NEWOS
  117.     MOVE.L    A0,(A6)
  118.     RTS
  119. END-CODE MACH
  120.  
  121. : NumToolboxTraps ( -- number )
  122.     $6E NGetTrapAddress.Tool    ( _InitGraf )
  123.     $AA6E NGetTrapAddress.Tool
  124.     =
  125.     IF $200 ELSE $400 THEN
  126.     ;
  127. #ifdef _EMBEDDED_
  128.     MACH
  129. #endif
  130.  
  131. ( I had to comment out this word, because the edge compiler corrupted
  132.   the flow when the macro compilation is used.  Apparently, when one 
  133.   word ends like
  134.  
  135.     " … IF constant1 ELSE constant2 THEN ;" 
  136.  
  137.   and is macro'ed into the sequence
  138.  
  139.     " … word1 -> lvar2 …"
  140.  
  141.   the edge optimizer steps on the … ELSE … THEN stack push and the 
  142.   branch after constant1 is incorrect.  I will have to watch out for this.  
  143.   This shows why edge compilers sometimes suck.
  144.  
  145. : GetTrapType        ( trap -- traptype )
  146.     $0800 
  147.     AND
  148.     0>
  149.     IF ToolTrap ELSE OSTrap THEN    
  150.     ;
  151. #ifdef _EMBEDDED_
  152.     MACH
  153. #endif
  154.  
  155. )
  156.  
  157. CODE GetTrapType
  158.     MOVE.L    (A6)+,D0
  159.     BTST    #11,D0
  160.     BEQ.S    @itsanOSTrap
  161.  
  162.     MOVEQ.L    #ToolTrap,D0
  163.     BRA.S    @flagonstack
  164.  
  165. @itsanOSTrap
  166.     MOVEQ.L    #OSTrap,D0
  167.  
  168. @flagonstack
  169.     MOVE.L    D0,-(A6)
  170.     RTS
  171. END-CODE
  172. #ifdef _EMBEDDED_
  173.     MACH
  174. #endif
  175.  
  176. : TrapAvailable?  { trap.# | trapType -- flag }
  177.  
  178.     trap.# GetTrapType -> trapType
  179.     trapType ToolTrap = 
  180.     IF
  181.         trap.#
  182.         $07FF AND
  183.         -> trap.#
  184.         trap.# NumToolboxTraps
  185.         < NOT
  186.         IF
  187.             UnknownTrap -> trap.#
  188.         THEN
  189.     THEN
  190.     trap.#
  191.     trapType ToolTrap =
  192.     IF
  193.         NGetTrapAddress.Tool
  194.     ELSE
  195.         NGetTrapAddress.OS
  196.     THEN
  197.     UnknownTrap NGetTrapAddress.Tool
  198.     = NOT
  199.     ;
  200. #ifdef _EMBEDDED_
  201.     MACH
  202. #endif
  203.  
  204. : is.Gestalt.Avail
  205.     ( -- flag )
  206.     Gestalt TrapAvailable?
  207.     ;
  208. #ifdef _EMBEDDED_
  209.     MACH
  210. #endif
  211.  
  212. : is.SysEnvirons.Avail
  213.     ( -- flag )
  214.     SysEnvirons TrapAvailable?
  215.     ;
  216. #ifdef _EMBEDDED_
  217.     MACH
  218. #endif
  219.  
  220. CODE (CALL).Gestalt
  221.     ( OSType @response -- result )
  222.     MOVE.L    4(A6),D0
  223.     MOVE.L    (A6),A0
  224.     ADDQ.W    #4,A6
  225.             _Gestalt
  226.     EXT.L    D0
  227.     MOVE.L    D0,(A6)
  228.     RTS
  229. END-CODE MACH
  230.  
  231. CODE CALL.Gestalt
  232.     ( OSType @response -- result )
  233.     EXG        D4,A7
  234.     MOVE.L    4(A6),D0
  235.     MOVE.L    (A6),A0
  236.     ADDQ.W    #4,A6
  237.             _Gestalt
  238.     EXT.L    D0
  239.     MOVE.L    D0,(A6)
  240.     EXG        D4,A7
  241.     RTS
  242. END-CODE MACH
  243.  
  244. ( here is included code to execute when SysEnvirons is not available )
  245.  
  246. : setenvironsVersion
  247.     ( -- version )
  248.     1
  249.     ;
  250. #ifdef _EMBEDDED_
  251.     MACH
  252. #endif
  253.  
  254. : setmachineType
  255.     ( -- n )
  256.  
  257.     ROMBase @ 9 + C@ $FF
  258.     = NOT
  259.     IF
  260.         ( it is not a MAC XL )
  261.         ROM85 W@ $8000 AND
  262.         0=
  263.         IF
  264.             ( it is a 512KE or better -
  265.               if it has the new clock chip it is a Mac Plus )
  266.             HWCfgFlags W@ New.Clock.Chip.Present.mask AND
  267.             0=
  268.             IF
  269.                 ( new clock chip is not present - a 512KE )
  270.                 1
  271.             ELSE
  272.                 ( at least a Plus )
  273.                 ( test for Mac SE or Mac II )
  274.                 ROMBase @ 8 + W@
  275.                 CASE
  276.                     $75 OF 2 ENDOF ( a MAC Plus )
  277.                     $76 OF 3 ENDOF ( a MAC SE )
  278.                     $78 OF 4 ENDOF ( a Mac II )
  279.                     ( else it is an unknown Mac )
  280.                     0 SWAP
  281.                 ENDCASE
  282.             THEN
  283.         ELSE
  284.             ( it's a 128 or 512K Mac)
  285.             -1 
  286.         THEN
  287.     ELSE
  288.         ( it is a Lisa )
  289.         -2
  290.     THEN
  291.     ;
  292. #ifdef _EMBEDDED_
  293.     MACH
  294. #endif
  295.  
  296. : set.System.Version
  297.     ( -- n  )
  298.     ( if this routine is called, it is because SysEnvirons doesn't exist,
  299.       so we can safely zero the System Version field )
  300.  
  301.     0
  302.     ;
  303. #ifdef _EMBEDDED_
  304.     MACH
  305. #endif
  306.  
  307. : set.processor.type
  308.     (  -- n )
  309.     CPUFlag C@ 3 >
  310.     IF
  311.         0
  312.     ELSE
  313.         CPUFlag C@ 1+
  314.     THEN
  315.     ;
  316. #ifdef _EMBEDDED_
  317.     MACH
  318. #endif
  319.  
  320. : set.FPU.exist
  321.     ( -- n )
  322.     HWCfgFlags W@ has.FPU.mask AND
  323.     0=
  324.     IF
  325.         0
  326.     ELSE
  327.         1
  328.     THEN
  329.     ;
  330. #ifdef _EMBEDDED_
  331.     MACH
  332. #endif
  333.  
  334. CODE set.Color.QD.exist
  335.     ( -- n )
  336.     MOVE.W    ROM85,-(A6)
  337.     CMPI.W    #$3FFF,(A6)
  338.     BHI.S    @noCQD
  339.  
  340.     MOVE.W    #1,(A6)
  341.     BRA.S    @addpad
  342.  
  343. @noCQD
  344.     CLR.W    (A6)
  345. @addpad
  346.     CLR.W    -(A6)
  347.     RTS
  348. END-CODE
  349. #ifdef _EMBEDDED_
  350.     MACH
  351. #endif
  352.  
  353. ( Comparing keyboard type in KbdType, and the value returned by SysEnvirons
  354.  
  355. KbdType     $03 $13 $0B $02 $01 $06 $07 $04 $05 $08 $09
  356.              |   |   |   |   |   |   |   |   |   |   |
  357. SysEnvirons $01 $02 $03 $04 $05 $06 $07 $08 $09 $0A $0B
  358.              |   |   |   |   |   |   |   |   |   |   |
  359.              |   |   |   |   |   |   |   |   |   |   Apple Keyboard II (ISO)
  360.              |   |   |   |   |   |   |   |   |   Apple Keyboard II
  361.              |   |   |   |   |   |   |   |   Apple Extended Keyboard (ISO)
  362.              |   |   |   |   |   |   |   Apple Standard Keyboard (ISO)
  363.              |   |   |   |   |   |   Portable Keyboard (ISO)
  364.              |   |   |   |   |   Portable Keyboard
  365.              |   |   |   |   standard Apple Desktop Bus keyboard
  366.              |   |   |   Apple extended Kbd
  367.              |   |   Macintosh Plus keyboard
  368.              |   Macintosh keyboard and keypad
  369.              Macintosh keyboard
  370. )
  371.  
  372. ( SysEnvirons returned constants )
  373. 0    CONSTANT envUnknownKbd        ( Macintosh Plus keyboard with keypad )
  374. 1    CONSTANT envMacKbd            ( Macintosh keyboard )
  375. 2    CONSTANT envMacAndPad        ( Macintosh keyboard and keypad )
  376. 3    CONSTANT envMacPlusKbd        ( Macintosh Plus keyboard )
  377. 4    CONSTANT envAExtendKbd        ( Apple extended Kbd )
  378. 5    CONSTANT envStandADBKbd        ( standard Apple Desktop Bus keyboard )
  379. 6    CONSTANT envPortADBKbd        ( Portable Keyboard )
  380. 7    CONSTANT envPortISOADBKbd    ( Portable Keyboard (ISO) )
  381. 8    CONSTANT envStdISOADBKbd    ( Apple Standard Keyboard (ISO) )
  382. 9    CONSTANT envExtISOADBKbd    ( Apple Extended Keyboard (ISO) )
  383. 10    CONSTANT envADBKbdII        ( Apple Keyboard II )
  384. 11    CONSTANT envADBISOKbdII        ( Apple Keyboard II (ISO) )
  385.  
  386. 11    CONSTANT no.of.kbds
  387.  
  388. CODE get.keyboard.type
  389.     ( -- type )
  390.     BRA.S    @dokb
  391.  
  392.     ( Compile a CONSTANT array of keyboard types )
  393.     DC.B    $03 
  394.     DC.B    $13 
  395.     DC.B    $0B
  396.     DC.B    $02 
  397.     DC.B    $01 
  398.     DC.B    $06 
  399.     DC.B    $07 
  400.     DC.B    $04 
  401.     DC.B    $05 
  402.     DC.B    $08
  403.     DC.B    $09
  404. .ALIGN
  405. @dokb
  406.     LEA        -2(PC),A0
  407.     MOVE.B    KbdType,D0                \ get current keyboard type
  408.     MOVE.W    #no.of.kbds,D1
  409.     SUBQ.W    #1,D1
  410. @next.type
  411.     CMP.B    -(A0),D0
  412.     DBEQ    D1,@next.type
  413.  
  414.     ADDQ.W    #1,D1
  415.     EXT.L    D1
  416.     MOVE.L    D1,-(A6)
  417.     RTS
  418. END-CODE
  419. #ifdef _EMBEDDED_
  420.     MACH
  421. #endif
  422.  
  423. ( Now we need to get the AppleTalk version number )
  424.  
  425. : get.AppleTalk.Version
  426.     ( -- version )
  427.  
  428.     ( first check SPConfig and PortBUse )
  429.     SPConfig C@ $0F AND
  430.     1 =
  431.  
  432.     ( port is configured for ATalk, check for PortBUse )
  433.     PortBUse C@ 0>
  434.     AND
  435.  
  436.     PortBUse C@ $0F AND
  437.     1 = 
  438.     AND
  439.     IF
  440.         ( AppleTalk .MPP is open, so get the version number )
  441.         UTableBase @ 36 + @    ( addr of .MPP DCE )
  442.         7 + C@
  443.     ELSE
  444.         ( AppleTalk not open )
  445.         0
  446.     THEN
  447.     ;
  448. #ifdef _EMBEDDED_
  449.     MACH
  450. #endif
  451.  
  452. : call.HGetVInfo
  453.     ( This routine used the variable array "file.iopb" and "vol.name"
  454.       and calls the ROM routine HGetVInfo, using a passed-in volume ID.)
  455.  
  456.     { volume.ID @file.ioPB @vol.name -- resultcode }
  457.  
  458.     0 ioCompletion            .OF. @file.ioPB !
  459.     @vol.name ioFileName    .OF. @file.ioPB !
  460.     volume.ID ioVRefNum        .OF. @file.iopb W!
  461.     0 ioVolIndex            .OF. @file.ioPB W!
  462.     @file.iopb (CALL) HGetVInfo ( -- result )
  463.     ;
  464. #ifdef _EMBEDDED_
  465.     MACH
  466. #endif
  467.  
  468. : get.THE.blessed.WD
  469.     ( This routine gets the Working directory number of the
  470.       blessed folder that contains the current open system file -
  471.       use this routine when SysEnvirons is not available.)
  472.  
  473.     ( -- WDRefNum )
  474.  
  475.     { | @file.ioPB -- }
  476.  
  477.     ( do it the hard and scary way )
  478.  
  479.     122 alloc.tempmem -> @file.ioPB
  480.  
  481.     0            ioCompletion    .OF. @file.iopb !
  482.     0            ioVRefNum        .OF. @file.iopb W!
  483.     SysMap W@    ioRefNum        .OF. @file.iopb W!
  484.     0            ioFCBIndex        .OF. @file.iopb !
  485.     @file.iopb (CALL) GetFCBInfo ( -- result.code )
  486.     0=
  487.     IF
  488.         ioVRefNum .OF. @file.iopb W@
  489.         DUP 0=
  490.         IF
  491.             ( dir.ID -- )
  492.             ( either the volume is MFS or there is no blessed
  493.               folder on this volume )
  494.  
  495.             ioVSigWord .OF. @file.iopb W@
  496.             TSigWord =
  497.             IF
  498.                 ( it's an HFS volume with no blessed folder, so it's
  499.                   not the boot volume.  Use the global BootDrive to
  500.                   find the boot drive and get it's blessed folder ID.)
  501.                 DROP
  502.                 BootDrive W@
  503.                 @file.ioPB
  504.                 0
  505.                 ( -- vol.ID @file.ioPB @vol.name )
  506.                 call.HGetVInfo
  507.                 0=
  508.                 IF
  509.                     ioVFndrInfo .OF. @file.iopb @ 
  510.                 ELSE
  511.                     ( a fatal error occurred )
  512.                     0
  513.                 THEN
  514.             THEN
  515.         THEN
  516.         ( -- dir.ID )
  517.     ELSE
  518.         ( a fatal error occurred )
  519.         0
  520.     THEN
  521.     dispos.tempmem
  522.     ( -- WDRefNum )
  523.     ;
  524. #ifdef _EMBEDDED_
  525.     MACH
  526. #endif
  527.  
  528. CODE fake.SysEnv
  529.     ( version @SysEnvRec  -- result )
  530.  
  531.     MOVE.L    A3,-(A7)        \ save A3
  532.  
  533.     MOVE.L    (A6)+,A3        \ get the SysEnvRec pointer
  534.  
  535.     setenvironsVersion
  536.     MOVE.L    (A6)+,D0
  537.     MOVE.W    D0,(A3)+
  538.  
  539.     setmachineType        \ get the Machine type
  540.     MOVE.L    (A6)+,D0
  541.     MOVE.W    D0,(A3)+
  542.  
  543.     set.System.Version    \ get the system file version
  544.     MOVE.L    (A6)+,D0
  545.     MOVE.W    D0,(A3)+
  546.  
  547.     set.processor.type    \ get the CPU type
  548.     MOVE.L    (A6)+,D0
  549.     MOVE.W    D0,(A3)+
  550.  
  551.     set.FPU.exist        \ is there a floating point processor
  552.     MOVE.L    (A6)+,D0
  553.     MOVE.B    D0,(A3)+
  554.  
  555.     set.Color.QD.exist        \ is color QuickDraw available
  556.     MOVE.L    (A6)+,D0
  557.     MOVE.B    D0,(A3)+
  558.  
  559.     get.keyboard.type        \ which keyboard are we using
  560.     MOVE.L    (A6)+,D0
  561.     MOVE.W    D0,(A3)+
  562.  
  563.     get.AppleTalk.Version
  564.     MOVE.L    (A6)+,D0
  565.     MOVE.W    D0,(A3)+
  566.  
  567.     get.THE.blessed.WD
  568.     MOVE.L    (A6)+,D0
  569.     MOVE.W    D0,(A3)+
  570.  
  571.     MOVE.L    (A7)+,A3
  572.     MOVE.L    #-5500,(A6)
  573.     RTS
  574. END-CODE
  575. #ifdef _EMBEDDED_
  576.     MACH
  577. #endif
  578.  
  579. CODE CALL.SysEnvirons
  580.     ( version @SysEnvRec -- result )
  581.     is.SysEnvirons.Avail
  582.     TST.L    (A6)+
  583.     BEQ.S    @noSysEnv
  584.  
  585.     EXG    D4,A7
  586.     MOVE.W    6(A6),D0
  587.     MOVE.L    (A6),A0
  588.     ADDQ.W    #4,A6
  589.             _SysEnvirons
  590.     EXT.L    D0
  591.     MOVE.L    D0,(A6)
  592.     EXG    D4,A7
  593.     BRA    @this.exit
  594.  
  595. @noSysEnv
  596.     fake.SysEnv
  597. @this.exit
  598.     RTS
  599. END-CODE
  600. #ifdef _EMBEDDED_
  601.     MACH
  602. #endif
  603.  
  604. CODE (CALL).SysEnvirons
  605.     ( version @SysEnvRec -- result )
  606.     is.SysEnvirons.Avail
  607.     TST.L    (A6)+
  608.     BEQ.S    @noSysEnv
  609.  
  610.     MOVE.W    6(A6),D0
  611.     MOVE.L    (A6),A0
  612.     ADDQ.W    #4,A6
  613.             _SysEnvirons
  614.     EXT.L    D0
  615.     MOVE.L    D0,(A6)
  616.     BRA    @this.exit
  617.  
  618. @noSysEnv
  619.     fake.SysEnv
  620. @this.exit
  621.     RTS
  622. END-CODE
  623. #ifdef _EMBEDDED_
  624.     MACH
  625. #endif
  626.  
  627.     restore.VOCAB.state
  628.  
  629. #endif ( COMPATIBILITY definitions )
  630.  
  631.